home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / efs.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  19.3 KB  |  650 lines
  1. 50  KEY OFF
  2. 100  GOSUB 6340
  3. 110  REM 
  4. 120  CLEAR
  5. 130  ON ERROR GOTO 6100
  6. 140  DT$ = "07/01/82"
  7. 150  VE$ = "  -  1.0.0"
  8. 160   DIM R$(65),AC(21),K(65),H$(21),RN$(21),KC(65)
  9. 170   DIM Z$(21)
  10. 180  COMMA$ = "NO"
  11. 190  BASENAME$="BSN"
  12. 200  HEADER$="HDR"
  13. 210  INDEX$="IDX"
  14. 220  RPTFMT$="RFT"
  15. 230  REM
  16. 250  CLS
  17. 260  H$(0) = "REC #"
  18. 270  B=65
  19. 280  DB$ = "BASENAME":F$ = BASENAME$:EX = 1110
  20. 290   GOSUB 4770
  21. 300   GOTO 2050
  22. 310  F$ = HEADER$:EX = 1140
  23. 320   GOSUB 4770
  24. 330   FOR I = 1 TO NR:H$(I) = R$(I): NEXT I
  25. 340  NH = NR:NR = 0:MEM =  FRE (0)
  26. 350  IF NH <= 0 THEN 5580
  27. 360  B =  INT (MEM / (13 * NH))
  28. 370  DIM N$(B,NH),R(B)
  29. 380  F$ = INDEX$:EX = 1200
  30. 390   GOSUB 4770
  31. 400   GOTO 5580
  32. 410   REM ***SORT***
  33. 420   FOR I = 1 TO NR:R(I) = 0: NEXT I
  34. 430   FOR I = 1 TO NR: FOR J = 1 TO NR
  35. 440   ON L GOTO 450,470
  36. 450   IF N$(I,S) =  > N$(J,S) THEN R(I) = R(I) + 1
  37. 460   GOTO 480
  38. 470   IF  VAL (N$(I,S)) =  >  VAL (N$(J,S)) THEN R(I) = R(I) + 1
  39. 480  L$ = INKEY$:IF LEN(L$) = 0 THEN 500
  40. 490  IF ASC(L$) = 27 THEN 110
  41. 500   NEXT J: NEXT I
  42. 510   COLOR 10,7:PRINT "Sorting pass 2 : ";:COLOR 7,0
  43. 520   FOR I = NR TO 1 STEP  - 1: FOR J = NR TO 1 STEP  - 1
  44. 530   IF I <  > J THEN  IF R(I) = R(J) THEN R(J) = R(J) - 1
  45. 540  L$ = INKEY$:IF LEN(L$) = 0 THEN 560
  46. 550  IF ASC(L$) = 27 THEN 110
  47. 560   NEXT J: NEXT I
  48. 570   COLOR 10,7:PRINT "Sorting final pass : ";:COLOR 7,0
  49. 580  J = 1
  50. 590   IF R(J) = J THEN J = J + 1: GOTO 590
  51. 600   IF J >  = NR THEN 670
  52. 610   FOR I = 1 TO NH:Z$(I) = N$(R(J),I):N$(R(J),I) = N$(J,I)
  53. 620  L$ = INKEY$: IF LEN(L$) = 0 THEN 640
  54. 630  IF ASC(L$) = 27 THEN 110
  55. 640   N$(J,I) = Z$(I): NEXT I
  56. 650  Z = R(R(J)):R(R(J)) = R(J):R(J) = Z
  57. 660   GOTO 590
  58. 670   PRINT: PRINT "Want to save the '";DB$;"' file sorted by '";H$(S);"' back to disk "
  59. 680  INPUT "Enter (Y or N)";L$
  60. 690  IF L$ <> "Y" AND L$ <> "y" AND L$ <>"N" AND L$ <> "n" THEN BEEP: GOTO 670
  61. 700   IF L$ = "Y" OR L$ = "y" THEN F$ = INDEX$: GOSUB 5010
  62. 710   GOTO 5580
  63. 720  CLS:MF = 1: GOSUB 4400
  64. 730   INPUT "Enter the  'FIELD #'  for sort or (Q, M, or F) ";S$:S =  VAL(S$):EX$ = S$:GOSUB 6290
  65. 740   IF S < 1 OR S > NH THEN BEEP: GOTO 730
  66. 750   PRINT : COLOR 8,7:PRINT "Do you want to sort:";:COLOR 7,0: PRINT :PRINT
  67. 760   PRINT "(";:COLOR 8,7:PRINT "A";:COLOR 7,0:PRINT ")lphabetically"
  68. 770   PRINT "(";:COLOR 8,7:PRINT "N";:COLOR 7,0:PRINT ")umerically"
  69. 780   PRINT
  70. 790   INPUT "Enter (A or N) or (Q, M, or F) ";L$:L=0:EX$=L$:GOSUB 6290
  71. 800  IF L$ = "A" OR L$ = "a" THEN L = 1
  72. 810  IF L$ = "N" OR L$ = "n" THEN L = 2
  73. 820  IF L < 1 OR L > 2 THEN BEEP: GOTO 790
  74. 830   PRINT :COLOR 8,7:PRINT "Press 'ESC' Key to Terminate Sort";:COLOR 7,0:PRINT: COLOR 10,7:PRINT "Sorting pass 1 : ";:COLOR 7,0: GOTO 420
  75. 840   REM ***CREATE HEADERFILE***
  76. 850  NR = 1
  77. 860   CLS: PRINT "Press 'RETURN' for Main Menu"
  78. 870   PRINT
  79. 880  PRINT "Enter Name for 'FIELD #' ";NR;:LINE INPUT": ";R$(NR)
  80. 890   IF R$(NR) = "" OR NR > 20 THEN 920
  81. 900  NR = NR + 1
  82. 910   GOTO 880
  83. 920  NR = NR - 1
  84. 930  EX = 1605
  85. 940   GOSUB 5010: GOTO 330
  86. 950   REM ***ENTER RECORDS***
  87. 960   CLS
  88. 970   PRINT "There are ";NR;" records in the '";DB$;"' file - room for ";:COLOR 8,7:PRINT B-NR;:COLOR 7,0:PRINT " more"
  89. 980  IF B - NR < 1 THEN 1100
  90. 990  NR = NR + 1
  91. 1000   PRINT "You are entering record number ";NR
  92. 1010   PRINT
  93. 1020   FOR I = 1 TO NH
  94. 1030   PRINT H$(I);":";: GOSUB 5550:N$(NR,I) = I$
  95. 1040   NEXT I
  96. 1050   PRINT
  97. 1060   PRINT "Do you want to enter more records on this file ?"
  98. 1070  INPUT "Enter (Y or N) or (Q or F)";L$:EX$ = L$: GOSUB 6310
  99. 1080   IF L$ ="Y" OR L$ = "y" THEN CLS:GOTO 970
  100. 1090   IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 1060
  101. 1100  F$ = INDEX$
  102. 1110   GOSUB 5010
  103. 1120   GOTO 5580
  104. 1130   REM ***SEARCH/CHANGE***
  105. 1140  L = 0
  106. 1150   CLS
  107. 1160   PRINT "You may ";:COLOR 8,7:PRINT "SEARCH";:COLOR 7,0:PRINT " on any of the following fields"
  108. 1170   PRINT
  109. 1180   GOSUB 4400
  110. 1190  PRINT "or you may"
  111. 1200  PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")hange data in a field"
  112. 1210   PRINT
  113. 1220   INPUT "Enter ('FIELD #' or C) or (Q, M, or F)";S$:S =  VAL(S$):EX$ = S$:GOSUB 6290
  114. 1230  IF S$ ="C" OR S$ = "c" THEN 1530
  115. 1240  IF S = 0 THEN IF S$ <> "0" THEN S = -1
  116. 1250   IF S < 0 OR S > NH  THEN BEEP: GOTO 1220
  117. 1260  REM
  118. 1270   PRINT "Enter the data for search on field '";:COLOR 8,7:PRINT H$(S);:COLOR 7,0:PRINT "' = ";:LINE INPUT " ";Q$
  119. 1280  IF LEN(Q$) = 0 THEN BEEP:GOTO 1270
  120. 1290  Z$ = " "+Q$
  121. 1300   CLS
  122. 1310   FOR J = 1 TO NR
  123. 1320  N$(J,0) =  STR$(J)
  124. 1330  IF S = 0 THEN IF N$(J,0) = Z$ THEN GOSUB 1690
  125. 1340  IF S = 0 THEN 1380
  126. 1350  FOR I = 1 TO LEN(N$(J,S))
  127. 1360  IF MID$(N$(J,S),I,LEN(Q$)) = Q$ THEN GOSUB 1690: GOTO 1380
  128. 1370  NEXT I
  129. 1380   IF L + NH > 21 THEN  GOSUB 1480
  130. 1390   NEXT J
  131. 1400  L=0
  132. 1410   COLOR 10,7:PRINT "That's all of them; now you may":COLOR 7,0
  133. 1420  PRINT "(";:COLOR 10,7:PRINT "S";:COLOR 7,0:PRINT ")earch additional records"
  134. 1430  PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")hange data in fields"
  135. 1440   INPUT "Enter (S or C) or (Q, M, or F)";S$:S =  0:EX$ = S$: GOSUB 6290
  136. 1450  IF S$ = "S" OR S$ = "s" THEN 1150
  137. 1460  IF S$ = "C" OR S$ = "c" THEN 1530
  138. 1470  BEEP: GOTO 1440
  139. 1480   IF PF <  > 0 THEN 1520
  140. 1490  PRINT "Press ";:COLOR 8,7:PRINT "RETURN";:COLOR 7,0:PRINT " to continue, or Enter ";:COLOR 8,7:PRINT "(Q, M, or F)";:COLOR 7,0
  141. 1500  INPUT L$:EX$ = L$: GOSUB 6290
  142. 1510   IF LEN(L$) <  > 0 THEN BEEP: GOTO 1500
  143. 1520  L = 0: CLS : RETURN
  144. 1530   REM ***CHANGE DATA***
  145. 1540  INPUT "Enter number of the record ('REC #') you want to change or (Q, M, or F) ";J$:J = VAL(J$):EX$ = J$:GOSUB 6290
  146. 1550  IF J < 1 OR J > NR THEN BEEP:COLOR 26,0:PRINT "Invalid Record Number":COLOR 7,0:GOTO 1540
  147. 1560   CLS : GOSUB 1690
  148. 1570  INPUT "Enter number of the field ('FIELD #') you want to change or (Q, M, or F) ";S$:S = VAL(S$):EX$ = S$: GOSUB 6290
  149. 1580  IF S< 1 OR S > NH THEN BEEP: GOTO 1570
  150. 1590   PRINT
  151. 1600   PRINT "From ";H$(S);": ";N$(J,S)
  152. 1610   PRINT
  153. 1620  PRINT "To ";H$(S);": ";:LINE INPUT " ";N$(J,S)
  154. 1630   CLS: GOSUB 1690
  155. 1640   PRINT
  156. 1650  INPUT "More changes ?      Enter (Y or N) or (Q, M, or F) ";L$:EX$ = L$: GOSUB 6290
  157. 1660  IF L$ = "Y" OR L$ = "y" THEN 1530
  158. 1670  IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 1650
  159. 1680  F$ = INDEX$: GOSUB 5010 : GOTO 5580
  160. 1690  REM ***PRINT A RECORD***
  161. 1700  PRINT "  ";H$(0);": ";J
  162. 1710  IF PF <> 0 THEN LPRINT "  ";H$(0);": ";J
  163. 1720  FOR I = 1 TO NH
  164. 1730  IF I = 1 THEN PRINT "FIELD #"
  165. 1740  IF PF <> 0 THEN IF I = 1 THEN LPRINT "FIELD #"
  166. 1750  PRINT I;"     ";H$(I);": ";N$(J,I)
  167. 1760  IF PF <> 0 THEN LPRINT I;"     ";H$(I);": ";N$(J,I)
  168. 1770  NEXT I
  169. 1780  PRINT
  170. 1790  IF PF <> 0 THEN LPRINT
  171. 1800  L =L + NH + 2
  172. 1810  REM
  173. 1820  RETURN
  174. 1830  REM ***DELETE RECORDS***
  175. 1840  CLS
  176. 1850  INPUT "Enter the Record Number ('REC #') you want deleted or (Q or F) ";DR$:EX$ = DR$: GOSUB 6310
  177. 1860  DR = VAL(DR$)
  178. 1870   IF DR < 1 OR DR > NR THEN BEEP:COLOR 26,0:PRINT "Invalid Record Number":COLOR 7,0:GOTO 1850
  179. 1880  CLS: FOR I = 1 TO NH
  180. 1890   PRINT H$(I);":"; N$(DR,I): NEXT I
  181. 1900   PRINT "Is this the record you want to delete ?":INPUT "Enter (Y or N)  ";G$
  182. 1910   IF G$ = "Y" OR G$ = "y" THEN  1940
  183. 1920  IF G$ <> "N" AND G$ <> "n" THEN BEEP: GOTO 1900
  184. 1930   GOTO 1830
  185. 1940   FOR J = DR TO NR - 1
  186. 1950   FOR I = 1 TO NH
  187. 1960  N$(J,I) = N$(J + 1,I)
  188. 1970   NEXT I
  189. 1980   NEXT J
  190. 1990   PRINT :NR = NR -1 : PRINT "Record Number ";:COLOR 26,0:PRINT DR;:COLOR 7,0:PRINT " Ready for Deletion"
  191. 2000   PRINT "Do you want to delete more records ?":INPUT "Enter (Y or N) or (Q or F) ";L$:EX$ = L$: GOSUB 6310
  192. 2010   IF L$ = "Y" OR L$ = "y" THEN 1850
  193. 2020  IF L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 2000
  194. 2030  PRINT "Requested Records Deleted"
  195. 2040  F$ = INDEX$: GOSUB 5010: GOTO 5580
  196. 2050   REM ***BASENAMEFILE ROUTINES***
  197. 2060   CLS
  198. 2070  LOCATE 1,25:COLOR 8,7: PRINT "  ******  I B M P C  ******":LOCATE 2,25:PRINT "  ELECTRONIC FILING SYSTEM ":LOCATE 3,25:PRINT DT$;"  VERSION";VE$:COLOR 7,0:LOCATE 4,33:PRINT "FILE MENU":PRINT:PRINT "Select File by Number:":PRINT
  199. 2080  Q=0
  200. 2090   FOR J = 1 TO NR:IF J < 10 THEN PRINT " ";J;" - ";R$(J); ELSE  PRINT J;" - ";R$(J);
  201. 2100  Q=Q+1:IF Q<4 THEN PRINT TAB(Q*18);"";ELSE Q=0:PRINT
  202. 2110  NEXT J: PRINT
  203. 2120  IF Q <> 0 THEN PRINT
  204. 2130  PRINT "or you may"
  205. 2140   PRINT "(";:COLOR 8,7:PRINT "C";:COLOR 7,0: PRINT ")reate a new file"
  206. 2150   IF J > 1 THEN PRINT "(";:COLOR 8,7:PRINT "D";:COLOR 7,0:PRINT ")elete a file"
  207. 2160  PRINT "(";:COLOR 8,7:PRINT "Q";:COLOR 7,0:PRINT ")uit"
  208. 2170   PRINT
  209. 2180   INPUT "Enter File Number or (C, D, or Q) ";S$:S =  0
  210. 2190  IF S$ = "C" OR S$ = "c" THEN S = J:GOTO 2240
  211. 2200  IF S$ = "D" OR S$ = "d" THEN IF J > 1 THEN S =J+1:GOTO 2240
  212. 2210  IF S$ = "Q" OR S$ = "q" THEN IF J > 1 THEN S = J+2:GOTO 2240
  213. 2220  IF S$ = "Q" OR S$ = "q" THEN IF J <= 1 THEN S = J + 1:GOTO 2240
  214. 2230  S = VAL(S$):IF S < 1 OR S > J -1 THEN BEEP: GOTO 2060
  215. 2240  IF J =< 1 AND S = J+1 THEN 5980
  216. 2250  IF S = J+2 THEN 5980
  217. 2260   IF S = J + 1 THEN 2450
  218. 2270   IF S < 1 OR S > J THEN  BEEP: GOTO 2060
  219. 2275  IF S$ = "C" OR S$ = "c" THEN 2290
  220. 2280  LOCATE 6,30:COLOR 26,0:PRINT "Loading File";:COLOR 7,0:PRINT " "
  221. 2290  DB$ = R$(S)
  222. 2300   IF S <  > J THEN 310
  223. 2310   PRINT
  224. 2320   GOTO 2340
  225. 2330   REM
  226. 2340   IF J = 0 THEN J = 1
  227. 2350  LINE INPUT "Name for new file  (Maximum 8 Characters) : ";T$
  228. 2360  GOSUB 5990:R$(J)=T$
  229. 2370  IF LEN(R$(J)) < 1 OR LEN(R$(J)) > 8 THEN BEEP: GOTO 2350
  230. 2380  IF J=1 THEN 2420
  231. 2390  FOR T = 1 TO J-1
  232. 2400  IF R$(T)=R$(J) THEN BEEP:COLOR 26,0:PRINT "Duplicate File Name":COLOR 7,0:GOTO 2350
  233. 2410  NEXT T
  234. 2420  NR = J: GOSUB 5010
  235. 2430  DB$ = R$(J - 1)
  236. 2440  GOTO 310
  237. 2450   REM ***DELETE A DATA BASE***
  238. 2460   PRINT : INPUT "Enter File Number to be ";:COLOR 8,7:PRINT "DELETED";:COLOR 7,0:PRINT " or (Q or F) ";S$:S =  VAL(S$):EX$ = S$: GOSUB 6310
  239. 2470   IF S < 1 OR S > J - 1 THEN BEEP: GOTO 2460
  240. 2480   CLS:PRINT  "Ready to delete the '";:COLOR 8,7:PRINT R$(S);:COLOR 7,0:PRINT "' file":PRINT
  241. 2490   PRINT "Once deleted this data cannot be recovered"
  242. 2500   PRINT "Are you ";:COLOR 26,0:PRINT "sure";:COLOR 7,0:PRINT " that you want to delete it ?":INPUT "Enter (Y or N) ";S$
  243. 2510  IF S$ = "N" OR S$ = "n" THEN 2050
  244. 2520   IF S$ <  > "Y"AND S$ <> "y"  THEN BEEP: GOTO 2500
  245. 2530   CLS:PRINT " Deleting the '";:COLOR 8,7:PRINT R$(S);:COLOR 7,0:PRINT "' file"
  246. 2540  EX = 2750
  247. 2550  DB$ = R$(S)
  248. 2560  F$ = RPTFMT$
  249. 2570   GOSUB 4770
  250. 2580  KILL DB$+"."+F$
  251. 2590   FOR I = 1 TO NR
  252. 2600  KILL DB$+"."+R$(I)
  253. 2610   NEXT I
  254. 2620  EX = 2840
  255. 2630  KILL DB$+"."+INDEX$
  256. 2640  EX = 2850
  257. 2650  KILL DB$+"."+HEADER$
  258. 2660  EX = 2859
  259. 2670  DB$ = "BASENAME"
  260. 2680  F$ = BASENAME$: GOSUB 4770
  261. 2690  EX = 2875
  262. 2700   REM
  263. 2710  IF NR = 1 THEN KILL "BASENAME"+"."+BASENAME$: GOTO 110
  264. 2720   FOR I = S TO NR - 1
  265. 2730  R$(I) = R$(I + 1)
  266. 2740   NEXT I
  267. 2750  NR = NR - 1: GOSUB 5010
  268. 2760   GOTO 2050
  269. 2770   REM ***REPORT***
  270. 2780  T9 = 0
  271. 2790  E = 0
  272. 2800   FOR I = 0 TO 3 * NH + 2:K(I) = 0:KC(I) = 0: NEXT I
  273. 2810   FOR I = 0 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0
  274. 2820   ON E GOTO 3140
  275. 2830   GOTO 4510
  276. 2840  INPUT "Enter the number of fields you want on the report or (Q, M, or F) ";RH$:RH =  VAL(RH$):EX$ = RH$: GOSUB 6290
  277. 2850  P$ = "Y"
  278. 2860   IF RH < 1 OR RH > NH  THEN BEEP: GOTO 2840
  279. 2870   IF E = 0 THEN RN$(NN) = "PRESENT"
  280. 2880   FOR I = 1 TO RH * 3 STEP 3
  281. 2890  CLS:GOSUB 4400
  282. 2900  PRINT "Enter the ";:COLOR 8,7:PRINT "'FIELD #'";:COLOR 7,0:PRINT " you want in report column # ";(I+2)/3;" or (Q, M, or F) ";:INPUT" ";K$:K(I)=VAL(K$):EX$ = K$:GOSUB 6290
  283. 2910  IF K(I) = 0 THEN IF K$ <> "0" THEN K(I) = -1
  284. 2920  IF I = 1 THEN 2950
  285. 2930  FOR PX = 1 TO I-3 STEP 3:IF K(I) = K(PX) THEN K(I) = -1
  286. 2940  NEXT PX
  287. 2950   IF K(I) <0 OR K(I) > NH THEN BEEP: GOTO 2900
  288. 2960  KC(I) = (I+2)/3
  289. 2970  PRINT "Enter tab position for ";:COLOR 8,7:PRINT H$(K(I));:COLOR 7,0:PRINT " or (Q, M, or F) ";:INPUT "";K$:K(I + 1)=VAL(K$):EX$ = K$: GOSUB 6290
  290. 2980   IF K(I +1) < 1 OR K(I+ 1) > 132 THEN BEEP:COLOR 26,0:PRINT "Tab must be (1 - 132)":COLOR 7,0:GOTO 2970
  291. 2990  IF K(I) = 0 THEN 3030
  292. 3000   PRINT "Total on ";:COLOR 8,7:PRINT H$(K(I));:COLOR 7,0:PRINT "      Enter (Y or N) ";: INPUT L$
  293. 3010  IF L$ <> "Y" AND L$ <>"y" AND L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 3000
  294. 3020   IF L$ = "Y" OR L$ = "y" THEN K(I + 2) = 1:K(0) = 1:T9=1
  295. 3030   NEXT I
  296. 3040   IF K(0) < > 1 THEN CLS:GOSUB 4400:GOTO 3140
  297. 3050  CLS:GOSUB 4400
  298. 3060  PRINT "Do you want a horizontal column total on your ";:COLOR 8,7:PRINT "TOTAL";:COLOR 7,0:PRINT " fields ?"
  299. 3070  INPUT "Enter (Y or N) ";A$
  300. 3080  IF A$ = "N" OR A$ = "n" THEN A$ = "":GOTO 3120
  301. 3090  IF A$<> "Y" AND A$ <> "y" THEN BEEP:GOTO 3060
  302. 3100   INPUT "Enter tab position for ";:COLOR 8,7:PRINT "TOTAL";:COLOR 7,0:PRINT " column or (Q, M, or F) ";A$:EX$ = A$:GOSUB 6290
  303. 3110  IF LEN(A$) = 0 THEN A$ = "0"
  304. 3120   IF  LEN(A$) = 0 THEN K(0) = 2:T9 = 1: GOTO 3140
  305. 3130  K(I + 1) =VAL(A$): IF K(I + 1) < 1 OR K(I + 1) > 132 THEN COLOR 26,0:PRINT "Tab must be (1 - 132)":COLOR 7,0: BEEP: GOTO 3100
  306. 3140  PRINT
  307. 3150  PRINT "To select all records press ";:COLOR 8,7:PRINT "'RETURN'";:COLOR 7,0:PRINT " or select records by field number"
  308. 3160  INPUT "Press 'RETURN' or Enter ('FIELD #') or (Q, M, or F) ";S$:S=VAL(S$):EX$ = S$ : GOSUB 6290
  309. 3170  L$ = "N"
  310. 3180  X$="@"
  311. 3190   IF LEN(S$) = 0 THEN Q$ = "@": GOTO 3320
  312. 3200  IF S < 1 OR S > NH THEN BEEP:GOTO 3160
  313. 3210  PRINT "Do you want to select records using two fields ?":INPUT "Enter (Y or N) ";L$: IF L$="Y" OR L$ = "y"  THEN 3250
  314. 3220  IF L$ <>"N" AND L$ <> "n" THEN BEEP: GOTO 3210
  315. 3230  X$ = "@"
  316. 3240  GOTO 3280
  317. 3250  PRINT: INPUT "Enter 2nd Field Number ('FIELD #') or (Q, M, or F) ";X$:X=VAL(X$):EX$ = X$: GOSUB 6290
  318. 3260  IF LEN(X$) = 0 THEN X$ = "@": GOTO 3280
  319. 3270  IF X < 1 OR X > NH THEN BEEP: GOTO 3250
  320. 3280  PRINT: PRINT " '@' will select all records"
  321. 3290  PRINT "Enter the data for search on field '";:COLOR 8,7:PRINT H$(S);:COLOR 7,0:PRINT "' = ";: LINE INPUT Q$
  322. 3300  IF Q$ <> "@" THEN IF L$ = "Y" OR L$ = "y"  THEN PRINT "Enter the data for search on field '";:COLOR 8,7:PRINT H$(X);:COLOR 7,0:PRINT "' = ";: LINE INPUT "";X$
  323. 3310  Z$=" "+Q$
  324. 3320  REM
  325. 3330  REM
  326. 3340  GOSUB 3990
  327. 3350   FOR J = 1 TO NR
  328. 3360  N$(J,0) =  STR$(J)
  329. 3370   IF Q$ = "@" THEN 3500
  330. 3380  IF S = 0 THEN 3430
  331. 3390  FOR I = 1 TO LEN(N$(J,S))
  332. 3400  IF MID$(N$(J,S),I,LEN(Q$)) = Q$ THEN 3450
  333. 3410  NEXT I
  334. 3420  GOTO 3510
  335. 3430  IF S = 0 THEN IF N$(J,0) = Z$ THEN 3450
  336. 3440  GOTO 3510
  337. 3450   IF X$ = "@" THEN 3500
  338. 3460  FOR I = 1 TO LEN(N$(J,X))
  339. 3470  IF  MID$(N$(J,X),I,LEN(X$)) = X$ THEN GOSUB 3660: GOTO 3510
  340. 3480  NEXT I
  341. 3490  GOTO 3510
  342. 3500  GOSUB 3660
  343. 3510   IF PF < 1 THEN  IF L > 22 THEN  GOSUB 1480: GOSUB 3990
  344. 3520   IF L = 0 THEN  GOSUB 3990
  345. 3530   NEXT J
  346. 3540   ON T9 GOSUB 3800
  347. 3550   REM
  348. 3560   ON E GOTO 3610
  349. 3570   PRINT : PRINT "Do you want to save this report format to ";:COLOR 8,7:PRINT "disk ?";:COLOR 7,0 :PRINT " "
  350. 3580  INPUT "Enter (Y or N) or (Q, M, or F) ";L$:EX$ = L$:GOSUB 6290
  351. 3590  IF L$<>"Y" AND L$ <> "y" AND L$ <> "N" AND L$ <>"n" THEN BEEP: GOTO 3570
  352. 3600   IF L$ = "Y" OR L$ = "y" THEN E = 1: GOSUB 4170
  353. 3610   PRINT : PRINT "More reports using the '";:COLOR 8,7:PRINT RN$(NN);:COLOR 7,0:PRINT "' format ?"
  354. 3620   INPUT "Enter (Y or N) or (Q, M, or F) ";L$:EX$ = L$: GOSUB 6290
  355. 3630  IF L$ <>"Y" AND L$ <> "y" AND L$ <> "N" AND L$ <> "n" THEN BEEP: GOTO 3610
  356. 3640   IF L$ = "Y" OR L$ = "y"  THEN E = 1: GOTO 2810
  357. 3650   GOTO 5580
  358. 3660   FOR I = 1 TO RH
  359. 3670   PRINT TAB(K(3*I-1));N$(J,K(3 * I - 2));
  360. 3680  IF PF <> 0 THEN  LPRINT TAB(K(3*I-1));N$(J,K(3*I-2));
  361. 3690   ON K(3 *I) GOSUB 3770
  362. 3700   NEXT I
  363. 3710  IF PF <> 0 THEN IF K(0)=1 THEN IF HC<>0 THEN LPRINT TAB(K(3*I-1));HC;
  364. 3720  IF K(0) =1 THEN IF HC<>0 THEN PRINT TAB(K(3*I-1));HC;:GT=GT+HC:HC=0
  365. 3730  L = L + 1
  366. 3740  PRINT
  367. 3750  IF PF <> 0 THEN  LPRINT
  368. 3760  RETURN
  369. 3770  N = 3 * I - 2
  370. 3780  V =  VAL(N$(J,K(N))):AC(I) = AC(I) + V:HC = HC + V
  371. 3790   RETURN
  372. 3800  KS=999:KT = 0: FOR I = 1 TO RH + 1: IF K(3*I-1) > KT THEN KT = K(3*I-1)
  373. 3810  IF K(3*I-1) > 0 THEN IF K(3*I-1) < KS THEN KS = K(3*I-1)
  374. 3820  NEXT I
  375. 3830  PRINT TAB(KS);:FOR I = KS TO KT + 5: PRINT "-";:NEXT I: PRINT
  376. 3840   FOR I = 1 TO RH
  377. 3850   IF AC(I) = 0 THEN 3870
  378. 3860   PRINT TAB((K(3*I-1))-1);AC(I);
  379. 3870   NEXT I
  380. 3880   IF GT <  > 0 THEN  PRINT TAB(K(3*I-1));GT;
  381. 3890  PRINT
  382. 3900  IF PF = 0 THEN 3980
  383. 3910  LPRINT TAB(KS);:FOR I = KS TO KT + 5:LPRINT "-";:NEXT I:LPRINT
  384. 3920  FOR I = 1 TO RH
  385. 3930  IF AC(I) = 0 THEN 3950
  386. 3940  LPRINT TAB(K(3*I-1));AC(I);
  387. 3950  NEXT I
  388. 3960  IF GT <> 0 THEN LPRINT TAB(K(3*I-1));GT;
  389. 3970  LPRINT
  390. 3980  RETURN
  391. 3990   CLS
  392. 4000   PRINT RN$(NN);" REPORT FOR ";H$(S);":";Q$;
  393. 4010  IF PF <> 0 THEN LPRINT RN$(NN);" REPORT FOR ";H$(S);":";Q$;
  394. 4020   IF X$ = "@" THEN 4060
  395. 4030   PRINT " AND ";H$(X);":";X$
  396. 4040  IF PF <> 0 THEN LPRINT " AND ";H$(X);":";X$
  397. 4050  GOTO 4080
  398. 4060   PRINT ""
  399. 4070  IF PF <> 0 THEN LPRINT ""
  400. 4080   FOR I = 1 TO RH
  401. 4090   PRINT TAB(K(3*I-1));H$(K(3 * I - 2));
  402. 4100  IF PF <> 0 THEN LPRINT TAB(K(3*I-1));H$(K(3*I-2));
  403. 4110   NEXT I
  404. 4120   IF K(0) = 1 THEN  PRINT TAB(K(3*I-1));"TOTAL";
  405. 4130  IF PF<>0 AND K(0) = 1 THEN LPRINT TAB(K(3*I-1));"TOTAL";
  406. 4140  PRINT : PRINT
  407. 4150  IF PF <> 0 THEN LPRINT:LPRINT
  408. 4160  L = 4: RETURN
  409. 4170  REM ***SET-UP TO SAVE RPTFMTFILE***
  410. 4180  NS = NR
  411. 4190  LINE INPUT "Enter the name of this Report Format (maximum 3 characters) ";T$
  412. 4200  GOSUB 5990:RN$(NN)=T$
  413. 4210  IF LEN(RN$(NN)) <1 OR LEN(RN$(NN)) >3  THEN BEEP: GOTO 4190
  414. 4220  IF NN=1 THEN 4260
  415. 4230  FOR T = 1 TO NN-1
  416. 4240  IF RN$(T)=RN$(NN) THEN BEEP:COLOR 26,0:PRINT "Duplicate Report Format Name":COLOR 7,0:GOTO 4190
  417. 4250  NEXT T
  418. 4260  F$ = RN$(NN) 
  419. 4270  NR = 3 * RH + 2
  420. 4280  FOR I = 1 TO NR:R$(I) = STR$(K(I)): NEXT I
  421. 4290  R$(I - 2) = STR$(K(0))
  422. 4300  GOSUB 5010 :GOSUB 5200
  423. 4310  RETURN
  424. 4320  REM ***SET-UP TO READ RPTFMTFILE***
  425. 4330  F$ = RN$(NN) 
  426. 4340  GOSUB 4770
  427. 4350  RH = (NR - 2) / 3:FOR I = 1 TO NR:K(I) = VAL(R$(I)):NEXT I
  428. 4360  K(0) = VAL(R$(I - 2))
  429. 4370  IF K(0) <> 0 THEN T9=1
  430. 4380  NR = NS
  431. 4390   GOSUB 4400: PRINT : GOTO 3150
  432. 4400   REM ***FILE MENU***
  433. 4410   PRINT "Select from:": PRINT
  434. 4420  IF P$ = "Y" THEN PRINT TAB(2);"TAB";TAB(8);"TOTAL   ";
  435. 4430  PRINT "FIELD #"
  436. 4440  IF T$ = "Y" THEN 4460
  437. 4450   IF MF = 0 THEN PRINT " 0      ";H$(0)
  438. 4460   FOR J = 1 TO NH
  439. 4470  IF P$ = "Y" THEN GOSUB 6480
  440. 4480  PRINT J;"     ";H$(J):NEXT J:PRINT
  441. 4490  MF = 0
  442. 4500   RETURN
  443. 4510   REM ***READ REPORTNAMEFILE & SELECT REPORT***
  444. 4520  NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  445. 4530  F$ = RPTFMT$
  446. 4540  EX = 3970
  447. 4550   GOSUB 4770
  448. 4560   FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  449. 4570   CLS : PRINT "Select from:": PRINT
  450. 4580  PRINT "FORMAT #"
  451. 4590   FOR I = 1 TO NR: PRINT I;"       ";R$(I): NEXT I: PRINT
  452. 4600  PRINT "or you may"
  453. 4610   PRINT "(";:COLOR 10,7:PRINT "C";:COLOR 7,0:PRINT ")reate a new Report Format"
  454. 4620   INPUT "Enter Report Format Number ('FORMAT #'or C) or (Q, M, or F) ";S$:S =  0:EX$ = S$
  455. 4630  IF S$ = "M" OR S$ = "m" THEN NR = NS
  456. 4640  GOSUB 6290
  457. 4650  IF S$ = "C" OR S$ = "c" THEN S = I :GOTO 4680
  458. 4660  S = VAL(S$)
  459. 4670  IF S < 1 OR S > I-1 THEN BEEP: GOTO 4620
  460. 4680  CLS
  461. 4690  NN = S
  462. 4700   IF S <  > I THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 4320
  463. 4710   GOTO 4760
  464. 4720   CLS : COLOR 26,0:PRINT "No Report Formats on disk":COLOR 7,0:: PRINT
  465. 4730  NN = 1
  466. 4740  PRINT "Do you want to create one ?":INPUT "Enter (Y or N) or (Q, M, or F)";L$:EX$ = L$ : GOSUB 6290:IF L$="N" OR L$ = "n" THEN 5580
  467. 4750  IF L$ <>"Y" AND L$ <> "y" THEN BEEP: GOTO 4740
  468. 4760  T$ = "Y": GOSUB 4400:NR =NS: GOTO 2840
  469. 4770   REM ***READ FILES***
  470. 4775  FF = 0
  471. 4780   IF F$ <  > INDEX$ THEN FF = 1
  472. 4790  REM
  473. 4800  REM
  474. 4810  IF F$ = BASENAME$ THEN DB$ = "BASENAME"
  475. 4820  OPEN "I",1,DB$+"."+F$
  476. 4830   INPUT #1, NR
  477. 4840   FOR J = 1 TO NR
  478. 4850   ON FF GOTO 4940
  479. 4860  IF J > B THEN CLS:COLOR 26,0:PRINT "FILE TOO LARGE - RECORD ";J;" BYPASSED  ---  CTL-S TO PAUSE CTL-Q TO RESUME":COLOR 7,0
  480. 4870   FOR I = 1 TO NH
  481. 4880  I$=""
  482. 4890  LINE INPUT#1, I$
  483. 4900  IF J > B THEN PRINT R$(I);" : "; I$: GOTO 4920
  484. 4910  N$(J,I) = I$
  485. 4920   NEXT I
  486. 4930  GOTO 4950
  487. 4940  LINE INPUT#1,R$(J)
  488. 4950  IF J > B THEN FOR X = 1 TO 3000:NEXT X: NR = B
  489. 4960  NEXT J
  490. 4970  REM
  491. 4980  CLOSE 1
  492. 4990  FF = 0
  493. 5000   RETURN
  494. 5010   REM ***SAVE FILES***
  495. 5015  FF = 0
  496. 5020   IF F$ <  > INDEX$ THEN FF = 1
  497. 5030  REM
  498. 5040  REM
  499. 5050  IF F$ = BASENAME$ THEN DB$ = "BASENAME"
  500. 5060  OPEN "O",1,DB$+"."+F$
  501. 5070   PRINT#1, NR
  502. 5080   FOR J = 1 TO NR
  503. 5090   ON FF GOTO 5140
  504. 5100   FOR I = 1 TO NH
  505. 5110   PRINT#1, N$(J,I)
  506. 5120   NEXT I
  507. 5130   GOTO 5150
  508. 5140   PRINT#1, R$(J)
  509. 5150   NEXT J
  510. 5160  CLOSE 1
  511. 5170  REM
  512. 5180  FF = 0
  513. 5190   RETURN
  514. 5200   REM ***SAVE REPORTNAMEFILE***
  515. 5210  NR = NN
  516. 5220  F$ = RPTFMT$
  517. 5230   FOR I = 1 TO NR:R$(I) = RN$(I): NEXT I
  518. 5240   GOSUB 5010
  519. 5250  NR = NS: RETURN
  520. 5260   REM ***LIST***
  521. 5270  L = 0
  522. 5280   CLS
  523. 5290   FOR J = 1 TO NR
  524. 5300  IF PF <> 0 THEN LPRINT "  ";H$(0);": ";J
  525. 5310   PRINT "  ";H$(0);": ";J:L = L + 1
  526. 5320   FOR I = 1 TO NH
  527. 5330  IF I = 1 THEN PRINT "FIELD #"
  528. 5340  IF I = 1 THEN IF PF <> 0 THEN LPRINT "FIELD #"
  529. 5350  IF PF <> 0 THEN LPRINT I;"     "H$(I);": ";N$(J,I)
  530. 5360   PRINT I;"     ";H$(I);": ";N$(J,I)
  531. 5370  L = L + 1
  532. 5380   NEXT I
  533. 5390  IF PF <> 0 THEN LPRINT
  534. 5400   PRINT :L = L + 1
  535. 5410  IF PF < > 0 THEN 5430
  536. 5420   IF L + NH > 20 THEN 5470
  537. 5430   NEXT J
  538. 5440   REM
  539. 5450  COLOR 26,0:PRINT "That's all of them":COLOR 7,0: INPUT "Press 'RETURN' to continue";L$
  540. 5460   GOTO 5580
  541. 5470   REM
  542. 5480   PRINT "Press ";:COLOR 8,7:PRINT "'RETURN'";:COLOR 7,0:PRINT " to continue, or (Q, M, or F)";
  543. 5490  INPUT L$:EX$ = L$ : GOSUB 6290
  544. 5500  IF LEN(L$) = 0 THEN 5530
  545. 5510  BEEP
  546. 5520   GOTO 5490
  547. 5530   CLS :L = 0
  548. 5540   GOTO 5430
  549. 5550   REM ***INPUT ROUTINES***
  550. 5560  I$ = ""
  551. 5570  LINE INPUT""; I$: RETURN
  552. 5580   REM ***MAIN MENU***
  553. 5590  REM
  554. 5600   CLS
  555. 5610  P$ = "":T$ = ""
  556. 5620  COLOR 8,7:LOCATE 1,15:PRINT"       ****** I B M P C ******     "
  557. 5625  COLOR 7,0:LOCATE 1,57:PRINT DATE$;"   ";TIME$:COLOR 8,7
  558. 5630  LOCATE 2,15:PRINT          "**** ELECTRONIC FILING SYSTEM  ****"
  559. 5640  LOCATE 3,15:PRINT          DT$;"       VERSION";VE$;"   "
  560. 5650  LOCATE 4,27:PRINT "MAIN MENU":COLOR 7,0
  561. 5660   PRINT
  562. 5670   PRINT TAB(20);"Current File: ";:COLOR 8,7:PRINT DB$:COLOR 7,0
  563. 5680   PRINT TAB(20);"Currently Contains: ";:COLOR 8,7:PRINT NR;:COLOR 7,0:PRINT " Records"
  564. 5690  PRINT TAB(20);"Room for ";:COLOR 8,7:PRINT B - NR;:COLOR 7,0:PRINT " More Records"
  565. 5700  PRINT TAB(20);"Available Free Space =";FRE(0)
  566. 5710   PRINT
  567. 5720  IF PF = 0 THEN PRINT TAB(20);"The Printer is OFF":GOTO 5740
  568. 5730   PRINT TAB(20);"The Printer is ";:COLOR 8,7:PRINT "ON";:COLOR 7,0:PRINT " -  132 Columns Wide"
  569. 5740   PRINT
  570. 5750   PRINT TAB(20);"(F)ile Menu"
  571. 5760   PRINT TAB(20);"(C)hange and/or Search Fields"
  572. 5770   PRINT TAB(20);"(E)nter Records"
  573. 5780   PRINT TAB(20);"(D)elete Records
  574. 5790   PRINT TAB(20);"(R)eport Generation
  575. 5800  PRINT TAB(20);"(S)ort - Takes Approximately" INT (0.000499999 * NR ^ 2 + 0.04 * NR)"Minutes"
  576. 5810   PRINT TAB(20);"(P)rinter ON/OFF
  577. 5820   PRINT TAB(20);"(L)ist Records"
  578. 5830   PRINT TAB(20);"(Q)uit"
  579. 5840   PRINT
  580. 5850  PRINT TAB(20);: INPUT "Enter (F, C, E, D, R, S, P, L, or Q) ";S$:S =  0:EX$ = S$ : GOSUB 6310
  581. 5860  IF S$ = "C" OR S$ = "c" THEN 1130
  582. 5870  IF S$ = "E" OR S$ = "e" THEN 950
  583. 5880  IF S$ = "D" OR S$ = "d" THEN 1830
  584. 5890  IF S$ = "R" OR S$ = "r" THEN 2770
  585. 5900  IF S$ = "S" OR S$ = "s" THEN 720
  586. 5910  IF S$ = "P" OR S$ = "p" THEN IF PF = 0 THEN 5950
  587. 5920  IF S$ = "P" OR S$ = "p" THEN IF PF <> 0 THEN 5970
  588. 5930  IF S$ = "L" OR S$ = "l" THEN 5260
  589. 5940  BEEP: GOTO 5580
  590. 5950   CLS
  591. 5960  PF$ = "5":PF = 5: GOTO 5580 :REM FORCE PRINTER TO 132
  592. 5970  PF = 0: GOTO 5580
  593. 5980  CLS:COLOR 8,7:LOCATE ,20:PRINT  "Exiting I B M P C  Electronic Filing System":COLOR 7,0:SYSTEM:  END
  594. 5990  REM ***VALIDATE FILE NAME ENTRIES***
  595. 6000  T=LEN(T$)
  596. 6010  IF T<1 THEN 6090
  597. 6020  FOR I = 1 TO T
  598. 6030  C$=MID$(T$,I,1)
  599. 6040  IF C$=>"0" AND C$<="9" THEN 6080
  600. 6050  IF C$=>"A" AND C$<="Z" THEN 6080
  601. 6060  IF C$=>"a" AND C$<="z" THEN 6080
  602. 6070  COLOR 26,0:PRINT "Invalid Name - name may contain   'A-Z'    'a-z'    '0-9' ONLY":COLOR 7,0:T$="":GOTO 6090
  603. 6080  NEXT I
  604. 6090  RETURN
  605. 6100  REM COMMON ERROR ROUTINE
  606. 6110  IF EX = 1110 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 2330
  607. 6120  IF EX = 1140 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 840
  608. 6130  IF EX = 1200 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 5580
  609. 6140  IF EX = 2750 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 2620
  610. 6150  IF EX = 2840 AND ERR = 53 AND ERL = 2630 THEN EX = 0:RESUME 2640
  611. 6160  IF EX = 2850 AND ERR = 53 AND ERL = 2650 THEN EX = 0:RESUME 2670
  612. 6170  IF EX = 3970 AND ERR = 53 AND ERL = 4820 THEN EX = 0:RESUME 4720
  613. 6180  IF ERR <> 7 THEN 6240
  614. 6190  FOR I = 1 TO 10:BEEP:NEXT I
  615. 6200  COLOR 26,0:PRINT "*** AVAILABLE MEMORY EXCEEDED ***":COLOR 7,0
  616. 6210  PRINT "Depress Any Key To Return To File Menu"
  617. 6220  XP$=INKEY$:IF XP$ = "" THEN 6220
  618. 6230  RESUME 110
  619. 6240  COLOR 26,0:PRINT "UNRECOVERABLE ERROR ENCOUNTERED":COLOR 7,0:FOR I = 1 TO 10:BEEP:NEXT I
  620. 6250  PRINT:PRINT "EX = ";EX;" ERR = ";ERR;" ERL = ";ERL"
  621. 6260  PRINT:PRINT "LAST FILE ACCESSED : ";DB$+"."+F$
  622. 6270  ON ERROR GOTO 0
  623. 6280  STOP
  624. 6290  REM COMMON EXIT ROUTINE
  625. 6300  IF EX$ = "M" OR EX$ = "m" THEN 5580
  626. 6310  IF EX$ = "Q" OR EX$ = "q" THEN 5980
  627. 6320  IF EX$ = "F" OR EX$ = "f" THEN 110
  628. 6330  RETURN
  629. 6340  REM SCREEN SCROLL
  630. 6350  CLS
  631. 6360  B=0
  632. 6370  FOR T= 0 TO 8.25 STEP 0.25
  633. 6380  A=INT(26+25*SIN(T))
  634. 6390  PRINT TAB(A-1);
  635. 6400  IF B=1 THEN 6440
  636. 6410  PRINT " >>>>>>>>>><<<<<<<<<<<<<< "
  637. 6420  B=1
  638. 6430  GOTO 6460
  639. 6440  PRINT "ELECTRONIC FILE SYSTEM"
  640. 6450  B=0
  641. 6460  NEXT T
  642. 6470  RETURN
  643. 6480  REM PRINT REPORT DATA
  644. 6490  FOR PX = 1 TO RH * 3 STEP 3
  645. 6500  IF K(PX) <> J THEN NEXT PX
  646. 6510  IF  KC(PX) = 0 THEN PRINT TAB(17);:RETURN
  647. 6520  PRINT TAB(2);K(PX+1);TAB(9);
  648. 6530  IF K(PX+2) = 1 THEN PRINT "YES     ";ELSE PRINT "NO      ";
  649. 6540  RETURN
  650.